home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 4 / Meeting Pearls Vol. IV (1996)(GTI - Schatztruhe)[!].iso / Pearls / dev / Oberon / OberonV4 / system / StampElems.Mod (.txt) < prev    next >
Oberon Text  |  1996-04-20  |  6KB  |  161 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. MODULE StampElems;    (* CAS 26 Jun 92, SHML 17 Mar 94 *)
  5.     IMPORT Files, Input, Display, Fonts, Texts, Oberon, Printer, TextFrames, TextPrinter;
  6.     TYPE
  7.         Elem = POINTER TO ElemDesc;
  8.         ElemDesc = RECORD (Texts.ElemDesc)
  9.             s: ARRAY 32 OF CHAR
  10.         END;
  11.         W: Texts.Writer;
  12.         month: ARRAY 12*3+1 OF CHAR;
  13.     PROCEDURE StrDispWidth (fnt: Fonts.Font; s: ARRAY OF CHAR): LONGINT;
  14.         VAR pat: Display.Pattern; width, i, dx, x, y, w, h: INTEGER; ch: CHAR;
  15.     BEGIN width := 0;
  16.         i := 0; ch := s[i];
  17.         WHILE ch # 0X DO
  18.             Display.GetChar(fnt.raster, ch, dx, x, y, w, h, pat); INC(width, dx);
  19.             INC(i); ch := s[i]
  20.         END;
  21.         RETURN LONG(width) * TextFrames.Unit
  22.     END StrDispWidth;
  23.     PROCEDURE DispStr (fnt: Fonts.Font; s: ARRAY OF CHAR; col, x0, y0: INTEGER);
  24.         VAR pat: Display.Pattern; i, dx, x, y, w, h: INTEGER; ch: CHAR;
  25.     BEGIN i := 0; ch := s[i];
  26.         WHILE ch # 0X DO
  27.             Display.GetChar(fnt.raster, ch, dx, x, y, w, h, pat);
  28.             Display.CopyPattern(col, pat, x0+x, y0+y, Display.invert);
  29.             INC(i); ch := s[i]; INC(x0, dx)
  30.         END
  31.     END DispStr;
  32.     PROCEDURE StrPrntWidth (fnt: Fonts.Font; s: ARRAY OF CHAR): LONGINT;
  33.         VAR width, dx, x, y, w, h: LONGINT; i: INTEGER; fno: SHORTINT; ch: CHAR;
  34.     BEGIN width := 0; fno := TextPrinter.FontNo(fnt);
  35.         i := 0; ch := s[i];
  36.         WHILE ch # 0X DO
  37.             TextPrinter.Get(fno, ch, dx, x, y, w, h); INC(width, dx);
  38.             INC(i); ch := s[i]
  39.         END;
  40.         RETURN width
  41.     END StrPrntWidth;
  42.     PROCEDURE PrntStr (fnt: Fonts.Font; s: ARRAY OF CHAR; x0, y0: INTEGER);
  43.     BEGIN Printer.String(x0, y0, s, fnt.name)
  44.     END PrntStr;
  45.     PROCEDURE Format (date: LONGINT; VAR s: ARRAY OF CHAR);
  46.         VAR i: INTEGER;
  47.         PROCEDURE Pair (x: LONGINT);
  48.         BEGIN
  49.             IF x >= 10 THEN s[i] := CHR(x DIV 10 + 30H); INC(i) END;
  50.             s[i] := CHR(x MOD 10 + 30H); INC(i)
  51.         END Pair;
  52.         PROCEDURE Label (m: LONGINT);
  53.         BEGIN m := (m-1)*3;
  54.             s[i] := month[m]; s[i+1] := month[m+1]; s[i+2] := month[m+2]; INC(i, 3)
  55.         END Label;
  56.     BEGIN i := 0;
  57.         Pair(date MOD 32); s[i] := " "; INC(i);
  58.         Label(date DIV 32 MOD 16); s[i] := " "; INC(i);
  59.         Pair(date DIV 512 MOD 128); s[i] := 0X
  60.     END Format;
  61.     PROCEDURE Copy (se, de: Elem);
  62.     BEGIN Texts.CopyElem(se, de); de.s := se.s
  63.     END Copy;
  64.     PROCEDURE Load (e: Elem; VAR r: Files.Rider);
  65.         VAR i: INTEGER; vers, ch: CHAR;
  66.     BEGIN Files.Read(r, vers); i := 0;
  67.         REPEAT Files.Read(r, ch); e.s[i] := ch; INC(i) UNTIL ch = 0X
  68.     END Load;
  69.     PROCEDURE Store (e: Elem; pos: LONGINT; VAR r: Files.Rider);
  70.         VAR t, d: LONGINT; i: INTEGER; ch: CHAR; s: ARRAY 32 OF CHAR;
  71.     BEGIN COPY(e.s, s); Oberon.GetClock(t, d); Format(d, e.s);
  72.         Files.Write(r, 1X); i := 0;
  73.         REPEAT ch := e.s[i]; Files.Write(r, ch); INC(i) UNTIL ch = 0X;
  74.         IF s # e.s THEN Texts.ChangeLooks(Texts.ElemBase(e), pos, pos+1, {}, NIL, 0, 0) END
  75.     END Store;
  76.     PROCEDURE PrepDraw (e: Elem; fnt: Fonts.Font; VAR dy: INTEGER);
  77.     BEGIN e.W := StrDispWidth(fnt, e.s); e.H := LONG(fnt.maxY-fnt.minY) * TextFrames.Unit;
  78.         dy := fnt.minY;
  79.         IF dy > -2 THEN dy := -2 END
  80.     END PrepDraw;
  81.     PROCEDURE Draw (e: Elem; pos: LONGINT; fnt: Fonts.Font; col, x0, y0: INTEGER);
  82.         VAR p: TextFrames.Parc; beg: LONGINT; w: INTEGER;
  83.     BEGIN w := SHORT(e.W DIV TextFrames.Unit);
  84.         TextFrames.ParcBefore(Texts.ElemBase(e), pos, p, beg);
  85.         INC(y0, SHORT(p.dsr DIV TextFrames.Unit));
  86.         DispStr(fnt, e.s, col, x0, y0);
  87.         Display.ReplPattern(col, Display.grey1, x0, y0-1, w, 1, Display.replace)
  88.     END Draw;
  89.     PROCEDURE PrepPrint (e: Elem; fnt: Fonts.Font; VAR dy: INTEGER);
  90.     BEGIN e.W := StrPrntWidth(fnt, e.s); e.H := LONG(fnt.maxY-fnt.minY) * TextFrames.Unit;
  91.         dy := SHORT(fnt.minY * LONG(TextFrames.Unit) DIV TextPrinter.Unit);
  92.         IF dy > -2 THEN dy := -2 END
  93.     END PrepPrint;
  94.     PROCEDURE Print (e: Elem; pos: LONGINT; fnt: Fonts.Font; x0, y0: INTEGER);
  95.         VAR p: TextFrames.Parc; beg: LONGINT;
  96.     BEGIN TextFrames.ParcBefore(Texts.ElemBase(e), pos, p, beg);
  97.         INC(y0, SHORT(p.dsr DIV TextPrinter.Unit));
  98.         PrntStr(fnt, e.s, x0, y0);
  99.         e.W := StrDispWidth(fnt, e.s)
  100.     END Print;
  101.     PROCEDURE Track (e: Elem; pos: LONGINT; x, y: INTEGER; keys: SET);
  102.     BEGIN
  103.         REPEAT Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y); Input.Mouse(keys, x, y)
  104.         UNTIL keys = {}
  105.     END Track;
  106.     PROCEDURE Handle (e: Texts.Elem; VAR msg: Texts.ElemMsg);
  107.         VAR copy: Elem;
  108.     BEGIN
  109.         WITH e: Elem DO
  110.             IF msg IS Texts.CopyMsg THEN
  111.                 NEW(copy); Copy(e, copy); msg(Texts.CopyMsg).e := copy
  112.             ELSIF msg IS Texts.IdentifyMsg THEN
  113.                 WITH msg: Texts.IdentifyMsg DO msg.mod := "StampElems"; msg.proc := "Alloc" END
  114.             ELSIF msg IS Texts.FileMsg THEN
  115.                 WITH msg: Texts.FileMsg DO
  116.                     IF msg.id = Texts.load THEN Load(e, msg.r)
  117.                     ELSIF msg.id = Texts.store THEN Store(e, msg.pos, msg.r)
  118.                     END
  119.                 END
  120.             ELSIF msg IS TextFrames.TrackMsg THEN
  121.                 WITH msg: TextFrames.TrackMsg DO
  122.                     IF msg.keys = {1} THEN Track(e, msg.pos, msg.X, msg.Y, msg.keys); msg.keys := {} END
  123.                 END
  124.             ELSIF msg IS TextFrames.DisplayMsg THEN
  125.                 WITH msg: TextFrames.DisplayMsg DO
  126.                     IF msg.prepare THEN PrepDraw(e, msg.fnt, msg.Y0)
  127.                     ELSE Draw(e, msg.pos, msg.fnt, msg.col, msg.X0, msg.Y0)
  128.                     END
  129.                 END
  130.             ELSIF msg IS TextPrinter.PrintMsg THEN
  131.                 WITH msg: TextPrinter.PrintMsg DO
  132.                     IF msg.prepare THEN PrepPrint(e, msg.fnt, msg.Y0)
  133.                     ELSE Print(e, msg.pos, msg.fnt, msg.X0, msg.Y0)
  134.                     END
  135.                 END
  136.             END
  137.         END
  138.     END Handle;
  139.     PROCEDURE Alloc*;
  140.         VAR e: Elem;
  141.     BEGIN NEW(e); e.handle := Handle; Texts.new := e
  142.     END Alloc;
  143.     PROCEDURE Open (e: Elem);
  144.         VAR t, d: LONGINT;
  145.     BEGIN e.W := 5*TextFrames.mm; e.H := e.W; e.handle := Handle;
  146.         Oberon.GetClock(t, d); Format(d, e.s)
  147.     END Open;
  148.     PROCEDURE Insert*;    (** [font] **)
  149.         VAR s: Texts.Scanner; T: Texts.Text; e: Elem; fnt: Fonts.Font; copyover: Oberon.CopyOverMsg;
  150.     BEGIN Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
  151.         IF (s.line = 0) & (s.class = Texts.Name) THEN fnt := Fonts.This(s.s) ELSE fnt := Oberon.CurFnt END;
  152.         NEW(e); Open(e);
  153.         T := TextFrames.Text(""); Texts.WriteElem(W, e); Texts.Append(T, W.buf);
  154.         Texts.ChangeLooks(T, 0, 1, {0}, fnt, 0, 0);
  155.         copyover.text := T; copyover.beg := 0; copyover.end := 1;
  156.         Oberon.FocusViewer.handle(Oberon.FocusViewer, copyover)
  157.     END Insert;
  158. BEGIN Texts.OpenWriter(W);
  159.     month := "JanFebMarAprMayJunJulAugSepOctNovDec"
  160. END StampElems.
  161.